home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
PROLOG
/
BP330
/
!BinPro330
/
progs
/
matrix
< prev
next >
Wrap
Text File
|
1995-02-06
|
3KB
|
135 lines
% Program: basic matrix manipulation package
% Author: Paul Tarau, 1995
% - argument for the vertues of an OR-intensive programming style
%
% THE POINT IS THAT WE CAN AVOID EXPLICIT ITERATION mainly because
% an OR-intensive style is `compositional' in the sense that
% it allows reuse of existing finite domain generators (i.e. for/3)
% The alternative: endless functor+arg+ I1 is I+1 hacking.
% makes a new vector of MaxI elements V, such that V[I]=VI,
% where VI is produced by generator Gen for each I
newv(Name,MaxI,Gen,I,VI,V):-
findall(VI,(for(I,1,MaxI),Gen),VIs),
V=..[Name|VIs].
% makes a 2-dim matrix M of MaxI X MaxJ elements, such that M[I,J]=MIJ,
% where MIJ is produced by Gen for each I,J
newm(MaxI,MaxJ,Gen,I,J,MIJ,M):-
newv(m,MaxI,
newv(v,MaxJ,(for(J,1,MaxJ),Gen),J,MIJ,V),
I,V,M).
% true iff M[I,J]=X
aref(M,I,J,X):-arg(I,M,V),arg(J,V,X).
% true iff M has I rows and J columns
dim(M,I,J):-
functor(M,_,I),
arg(1,M,V),
functor(V,_,J).
% M=M1+M2
sum(M1,M2,M):-sum_like(+,M1,M2,M).
% M=M1-M2
dif(M1,M2,M):-sum_like(-,M1,M2,M).
sum_like(Op,M1,M2,M):-
dim(M1,MaxI,MaxJ),
dim(M2,MaxI,MaxJ),
newm(MaxI,MaxJ,sumIJ(Op,M1,M2,I,J,X),I,J,X,M).
sumIJ(Op,M1,M2,I,J,X):-
aref(M1,I,J,X1),
aref(M2,I,J,X2),
call(Op,X1,X2,X).
% M = M1*M2
prod(M1,M2,M):-prod_like(+,*,M1,M2,M).
max(X,Y,Z):-compare(R,X,Y),order(R,X,Y,_,Z).
min(X,Y,Z):-compare(R,X,Y),order(R,X,Y,Z,_).
order(<,X,Y,X,Y).
order(=,X,Y,X,Y).
order(>,X,Y,Y,X).
prod_like(SumOp,MultOp,M1,M2,M):-
dim(M1,MaxI,MaxK),
dim(M2,MaxK,MaxJ),
newm(MaxI,MaxJ,
fold(SumOp,P^prodIJ(MultOp,M1,M2,MaxK,I,J,P),X),
I,J,X,M).
prodIJ(Op,M1,M2,MaxK,I,J,X):-
for(K,1,MaxK),
aref(M1,I,K,X1),
aref(M2,K,J,X2),
call(Op,X1,X2,X).
% M is the unit square matrix of dim N
id(N,M):-newm(N,N,(I=J->X=1;X=0),I,J,X,M).
% M is the 0 square matrix of dim N
zero(N,M):-newm(N,N,X=0,_,_,X,M).
% KM is K times M, where K is a scalar
times(K,M,KM):-
dim(M,MaxI,MaxJ),
newm(MaxI,MaxJ,(aref(M,I,J,X),KX is K*X),I,J,KX,KM).
% tools
% combines 2 by 2 (with Closure) answers I of Generator
% accumulating in Final the overall result
fold(Closure,I^Generator,Final):-
term_append(Closure,args(SoFar,I,O),Selector),
fold0(SoFar,I,O,Generator,Selector,Final).
fold0(SoFar,I,O,Generator,Selector,_):-
inc_level(fold,Level),
Generator,
select_or_init(Selector,Level,SoFar,I,O),
fail.
fold0(_,_,_,_,_,Final):-
dec_level(fold,Level),
bb_val(fold,Level,Final),
rm(fold,Level).
select_or_init(Selector,Level,SoFar,_,O):-
val(fold,Level,SoFar),!,
Selector,
bb_set(fold,Level,O).
select_or_init(_,Level,_,I,_):-
bb_def(fold,Level,I).
% ensure correct implementation of embedded calls to fold/4
inc_level(Obj,X1):-val(Obj,Obj,X),!,X1 is X+1,set(Obj,Obj,X1).
inc_level(Obj,1):-def(Obj,Obj,1).
dec_level(Obj,X):-val(Obj,Obj,X),X>0,X1 is X-1,set(Obj,Obj,X1).
test1:-
newm(3,3,(X is (I+J)//2),I,J,X,M),write(M),nl,
sum(M,M,R),
times(10,R,RR),
write(R),nl,
write(RR),nl.
test2:-id(3,Id),newm(3,3,(X is I+J),I,J,X,M),
prod(M,Id,R),prod(Id,M,RR),
write(M),nl,
write(R),nl,
write(RR),nl.
%